unit frmOptions; 

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
  StdCtrls, Inifiles; 

type
  
  
  { TOptions }

  TOptions = class ( TForm ) 
   Button1 : TButton;
   Button2: TButton;
   bxKey : TEdit;
   bxValue : TEdit;
   FontDialog1 : TFontDialog;
   Label1 : TLabel;
   Label2 : TLabel;
   Keys : TListBox;
   Values : TListBox;
   SelectDirectoryDialog1 : TSelectDirectoryDialog;
   procedure Button1Click ( Sender : TObject ) ;
   procedure Button2Click(Sender: TObject);
   procedure FormCreate ( Sender : TObject ) ;
   procedure ValuesClick ( Sender : TObject ) ;
  private
    { private declarations }
  public
    { public declarations }
  end; 

var
  Options : TOptions; 

type 
  optionsType = ({resultspath, }questionfont, answerfont, legendfont);
  
const 
  optionkeys : array [questionfont..legendfont] of string =
    (
     'The font of the questions',
     'The font of the answers',
     'The font of the legend');
  optiondefaults : array [questionfont..legendfont] of string =
    (
     '"default","0","clWindowText","-13","1","10","false","false","false","false"',
     '"default","0","clWindowText","-13","1","10","false","false","false","false"',
     '"default","0","clWindowText","-16","1","12","true","false","false","false"'
     );

  
function StringToFont(s:string):TFont;
function FontToString(aFont:TFont):string; 


implementation
uses mainunit ; 


function StringToFont(s:string):TFont;
var aFont : TFont;
    l : Tstringlist;
    style : string;
begin

  l := TStringlist.Create;
  l.CommaText := s;
  
  aFont := TFont.Create;
  try 
    aFont.Name := l[0];
    aFont.CharSet := TFontCharSet(StrToIntdef(l[1],0));
    aFont.Color := StringToColor(l[2]);
    aFont.Height := StrToInt(l[3]);
    aFont.Pitch := TFontPitch(strtoint(l[4]));
    //aFont.Quality := TFontQuality(strtoint(l[5]));
    aFont.Size := strtoint(l[5]);
    //style := l[9];      
  
    aFont.Style := [];
    if strtobool(l[6]) then aFont.Bold := true;
    if strtobool(l[7]) then aFont.Italic := true;
    if strtobool(l[8]) then aFont.StrikeTrough := true;
    if strtobool(l[9]) then aFont.Underline := true;
    
  except
  end;
  StringToFont := aFont;      
  
end;

function FontToString(aFont:TFont):string;
// Sample output 
// "FreeMono","1","clWindowText","-16","0","0","12","0","0","0","0"
var s : string;
    stylestr : string;
  function fix(s:string):string;
  var i : integer;
  begin
    i := 1;
    while i < length(s) do begin
      if s[i] = '"' then begin s := copy(s,1,i) + '"' + copy(s,i,length(s)); inc(i); end;
      inc(i);
    end;
    fix := s;
  end;

begin  
  s := aFont.Name;
  s := '"' + fix(s) + '"';
  s := s + ',"' + inttostr(aFont.CharSet) + '"';
  s := s + ',"' + ColorToString(aFont.Color) + '"';
  s := s + ',"' + inttostr(aFont.height) + '"';
  s := s + ',"' + inttostr(ord(aFont.Pitch)) + '"';
  //s := s + ',"' + inttostr(ord(aFont.Quality)) + '"';
  s := s + ',"' + inttostr(aFont.Size) + '"';
  
  
  s := s + ',"' + booltostr(aFont.Bold,true)  + '"';
  s := s + ',"' + booltostr(aFont.Italic,true ) + '"';
  s := s + ',"' + booltostr(aFont.StrikeTrough,true)  + '"';
  s := s + ',"' + booltostr(aFont.Underline,true) + '"';
 
  FontToString := s;
end;

{ TOptions }

procedure TOptions.ValuesClick ( Sender : TObject ) ;
begin
  if sender = keys then values.itemindex := keys.itemindex;
  keys.ItemIndex := Values.ItemIndex ;
  bxKey.Text := keys.items[keys.itemindex];
  bxValue.Text := Values.items[values.itemindex];
  
end;

procedure TOptions.Button1Click ( Sender : TObject ) ;
var i : OptionsType;
    s : string; 
begin
  i := OptionsType(values.itemindex);
  
  case i of
    {inipath :  begin
      if SelectDirectoryDialog1.execute then begin
        s := SelectDirectoryDialog1.FileName; 
        if s[length(s)]<> pathdelim then s := s + pathdelim; 
        bxValue.text := s;
        Values.items[ord(i)] := bxValue.Text;
        AbcOptions[ord(i)] := bxValue.Text; 
        OptionsIni.WriteString('General',OptionKeys[i],bxValue.Text); 
      end;
    end;}
    questionfont, answerfont, legendfont:  begin
      if FontDialog1.execute then begin
        bxValue.text := FontToString(FontDialog1.Font);
        Values.items[ord(i)] := bxValue.Text;
        AbcOptions[ord(i)] := bxValue.Text;
        OptionsIni.WriteString('General',OptionKeys[i],bxValue.Text);
        Mainform.ReRenderTest; 
      end;
    end;
  
  end;
end;

procedure TOptions.Button2Click(Sender: TObject);
begin
  Close;
end;

procedure TOptions.FormCreate ( Sender : TObject ) ;
var i : optionsType;

begin
  OptionsIni := TInifile.Create(AppPath + pathdelim + 'abc.ini');
    
  for i := questionfont to legendfont do  begin
    Keys.items.add(OptionKeys[i]);
    AbcOptions.Add(OptionsIni.ReadString('General',OptionKeys[i],OptionDefaults[i])) ; 
  end;
  
  for i := questionfont to legendfont do  begin
    OptionsIni.WriteString('General',OptionKeys[i],AbcOptions[ord(i)]) ; 
  end;
   
  Values.Items.text := AbcOptions.Text  ; 
end;

initialization
  {$I frmoptions.lrs}

end.

